Developer CD Series 1994 November: Tool Chest/Dev.CD Nov 94.toast/Sample Code/Snippets/Toolbox/BigScrolling/Big Scrolling.p

Text File | 1993-01-15 | 10.1 KB | 269 lines | [TEXT/PJMM]

{ Big Scrolling Pascal unit }

unit BigScrolling;

interface
uses
    Traps;

type

{ We attach this record, which contains longint values for the minimum, maximum and value of the control, to the }
{ control's refcon.  Our "MyGetCtlValue" and "MySetCtlValue" look for a pointer to this record in the control's }
{ refcon so we can find it. }

    bigValues = record
            bigMin: longint;
            bigMax: longint;
            bigValue: longint;
        end;
    bigValuesPtr = ^bigValues;

procedure InitializeApplication;
procedure TerminateApplication;
procedure CloseAppWindow (theWindow: WindowPtr);
procedure DrawWindow (theWindow: WindowPtr; drawingPort: grafPtr; printing: BOOLEAN; isActive: BOOLEAN);
procedure DoContentClick (window: WindowPtr; event: EventRecord);
procedure MySetCtlValue (theControl: ControlHandle; theValue: longint);
function MyGetCtlValue (theControl: ControlHandle): longint;
procedure FixMyCtlValue (theControl: ControlHandle);

implementation

var
    ourScrollBar: ControlHandle;

{ MySetCtlValue takes a longint control value.  It stuffs the value into the bigValues record pointed to by the }
{ control refcon and normalizes it into a 0..32767 range for the control's actual value (signed integer).  This}
{ is obviously a loss of precision, but it's OK because this is only used for displaying the thumb position by}
{ the Control Manager. }

procedure MySetCtlValue (theControl: ControlHandle; theValue: longint);

    var
        extendedValue: extended;
        intValue: integer;
        ourValues: bigValuesPtr;


    begin
        ourValues := bigValuesPtr(GetCRefCon(theControl));
        with ourValues^ do
            begin

{ We have to pin the value to our minimum and maximum values so we don't underflow or overflow. }

                if theValue > bigMax then
                    bigValue := bigMax
                else if theValue < bigMin then
                    bigValue := bigMin
                else
                    bigValue := theValue;

{ To normalize, we subtract the bigMin from bigMax to get the control's range of values.  Dividing that interval}
{ by 32767 tells us how much our longint control value has to change before the real control value changes by one. }
{ For example, if our range is 0 to 65535, the real control value moves by one every time our value changes}
{ by two.  Once we have that interval, we divide our real value by it to get a normalized value. }
{ (our Value)/(interval / 32767) is the same as (ourValue * 32767) / interval, which is the form we use.}
{ 32767 is expressed as 32767.0 so extended calculations are done, to avoid overflow even for really big}
{ values. }

                extendedValue := (((bigValue - bigMin) * 32767.0) / (bigMax - bigMin));
                                                                                        { this will always be between 0 and 32767 }
                intValue := round(extendedValue);                                            { explicitly truncate to integer }
                SetCtlValue(theControl, intValue);
            end;    {with}
    end;

{ MyGetCtlValue returns our longint value from the bigValues record attached to the refcon.  There's no calculation}
{ to do here, because MySetCtlValue and FixMyCtlValue does all that for us. }

function MyGetCtlValue (theControl: ControlHandle): longint;

    var
        ourValues: bigValuesPtr;

    begin
        ourValues := bigValuesPtr(GetCRefCon(theControl));
        MyGetCtlValue := ourValues^.bigValue;
    end;


{ FixMyCtlValue resets bigValue to something resembling the actual control value, for those occasions when the }
{ Control Manager drags the thumb for you and resets the value based on the min and max fields in the control }
{ record.   It reverses the MySetCtlValue calculation to get an approximation of where the big control value is for }
{ the place where the user dragged the thumb; this is the best we can do because the scroll bar is never going to get}
{ the resolution of the values (you can't have a scroll bar one million pixels tall).  In the special case that they're at }
{ the very bottom of the scroll bar, we set the value to bigMax so it's more consistent with what users expect. }
{ Since each step in the real control value represents many steps in ours, if the new control value is the same as }
{ where the old bigValue would put it, we don't change it.  This means if you click on the thumb but don't move it, }
{ the control value doesn't change. We have to use extended arithmetic here as well to avoid round-off errors.}

procedure FixMyCtlValue (theControl: ControlHandle);

    var
        allegedValue, intValue: integer;
        oldBigValue: longint;
        ourValues: bigValuesPtr;
        extendedValue, newBigExtended: extended;

    begin
        ourValues := bigValuesPtr(GetCRefCon(theControl));
        allegedValue := GetCtlValue(theControl);
        with ourValues^ do
            begin
                oldBigValue := bigValue;
{ To reverse the calculation, we divide the interval of possible values by the maximum real control value, then multiply }
{ that by the value the Control Manager has.  Since the minimum might not be zero, we add it in as well. }

                newBigExtended := (((((bigMax - bigMin) / 32767.0)) * allegedValue) + bigMin);
                bigValue := round(newBigExtended);

                        { Now, if that new bigValue has the same CtlValue as the old bigValue, restore the old one. }

                extendedValue := (((oldBigValue - bigMin) * 32767.0) / (bigMax - bigMin));
                                                                                        { this will always be between 0 and 32767 }
                intValue := round(extendedValue);                                            { explicitly truncate to integer }
                if intValue = allegedValue then
                    bigValue := oldBigValue
                else if allegedValue = 32767 then
                    bigValue := bigMax                                        { pin to bottom only if not changing value otherwise }

            end;   { with }
    end;              { procedure }

procedure InitializeApplication;
    var
        theWindow: WindowPtr;
        newValuesPtr: bigValuesPtr;

    begin

{ Create and show our window }

        theWindow := GetNewWindow(128, nil, Pointer(-1));        { window is invisible in the WIND resource }
        ourScrollBar := GetNewControl(128, theWindow);
        newValuesPtr := bigValuesPtr(NewPtr(sizeof(bigValues)));
        newValuesPtr^.bigMin := 0;                                                { an arbitrary minimum }
        newValuesPtr^.bigMax := 1500000;                                    { an arbitrary maximum }
        SetCRefCon(ourScrollBar, longint(newValuesPtr));            { put a pointer to the record in the control's refCon}
        MySetCtlValue(ourScrollBar, 1000000);                            { an arbitrary initial value }
        ShowWindow(theWindow);

    end;

procedure TerminateApplication;                                            { Called by Sample.p -- not needed in this unit }
    begin
    end;

procedure CloseAppWindow (theWindow: WindowPtr);

    begin
        DisposePtr(Ptr(GetCRefCon(ourScrollBar)));                        { Dispose of our bigValues structure }
        CloseWindow(theWindow);                                                    { and close the window. }
    end;

procedure DrawTheValue (theValue: longint);

    var
        tempString: Str255;
        myRect: Rect;
    begin
        SetRect(myRect, 40, 40, 150, 100);                                { an arbitrary sized rectangle to draw in }
        EraseRect(myRect);
        MoveTo(50, 50);
        TextFont(geneva);
        NumToString(theValue, tempString);                                    { turn the value into a string }
        DrawString(tempString);
    end;

{ This procedure is called by the shell-like Sample.p file to draw windows.  Sample.p sets "printing" to TRUE if }
{ it's printing (though this snippet doesn't print), so we ignore that.  We also ignore "isActive" because in this }
{ program, we have one window and it's always active, and we ignore "drawingPort" because it's NIL unless we're }
{ printing, in which case it's the printing grafPort.  All we have to do in this routine is call DrawControls to draw}
{ our scroll bar, then call DrawTheValue to provide an integer representation of it. }

procedure DrawWindow (theWindow: WindowPtr; drawingPort: grafPtr; printing: boolean; isActive: boolean);
    var
        oldPort: grafPtr;
        theValue: longint;
    begin
        GetPort(oldPort);
        SetPort(theWindow);
        DrawControls(theWindow);
        theValue := MyGetCtlValue(ourScrollBar);
        DrawTheValue(theValue);
        SetPort(oldPort);
    end;

{ NonThumbAction is the action routine we pass to TrackControl when the user clicks on the scroll arrows or page}
{ region of the scroll bar.  We add arbitrary values to the control value, then call MySetCtlValue to change the }
{ control's value and redraw it.  We then draw the value after retrieving it again -- we retrieve it with MyGetCtlValue }
{ just in case our last change would have gone under the minimum or over the maximum.  MySetCtlValue prevents that, }
{ and we get the corrected value before displaying it. }

procedure NonThumbAction (theControl: ControlHandle; partCode: integer);

    var
        ourValue: longint;

    const
        arrowUpAmount = -1;
        arrowDownAmount = 1;
        pageUpAmount = -1000;
        pageDownAmount = 1000;

    begin
        ourValue := MyGetCtlValue(theControl);

        case partCode of
            inUpButton:
                ourValue := ourValue + arrowUpAmount;
            inDownButton:
                ourValue := ourValue + arrowDownAmount;
            inPageUp:
                ourValue := ourValue + pageUpAmount;
            inPageDown:
                ourValue := ourValue + pageDownAmount;
        end;
        MySetCtlValue(theControl, ourValue);
        DrawTheValue(MyGetCtlValue(theControl));            { in case it got pinned to the minimum or maximum }
    end;

{ Sample.p calls DoContentClick when it finds a click in the content region of an app window (that's us).  Since all }
{ we care about is the scroll bar, we call FindControl and then TrackControl, passing NonThumbAction if they click}
{ in the scroll bar (but not in the thumb), and passing NIL if they click in the thumb.  If they dragged the thumb, we}
{ use FixMyCtlValue to repair the bigValue in our private record on the refcon. }

procedure DoContentClick (window: WindowPtr; event: EventRecord);
    var
        thePartCode, theNewPartCode: integer;
        ourLocalPoint: Point;
        ourControl: ControlHandle;
        oldPort: grafPtr;

    begin
        GetPort(oldPort);
        SetPort(window);
        ourLocalPoint := event.where;
        GlobalToLocal(ourLocalPoint);
        thePartCode := FindControl(ourLocalPoint, window, ourControl);
        case thePartCode of
            0:
                ;
                     { we get and ignore zero if they mouse up outside the part they mouse down-ed in }
            inUpButton, inDownButton, inPageUp, inPageDown:
                theNewPartCode := TrackControl(ourControl, ourLocalPoint, @NonThumbAction);
            inThumb:
                begin
                    theNewPartCode := TrackControl(ourControl, ourLocalPoint, nil);
                    FixMyCtlValue(ourControl);                { change bigValue to match to where they moved the thumb }
                    DrawTheValue(MyGetCtlValue(ourControl));
                end;
        end;                { case thePartCode of }
        SetPort(oldPort);

    end;


end.